home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / lib_tix.tcl < prev    next >
Encoding:
Text File  |  1997-05-29  |  21.3 KB  |  628 lines
  1. ##############################################################################
  2. #
  3. # lib_tix.tcl - tix widget support library
  4. #
  5. # Copyright (C) 1996-1997 Stewart Allen
  6. #
  7. # This program is free software; you can redistribute it and/or
  8. # modify it under the terms of the GNU General Public License
  9. # as published by the Free Software Foundation; either version 2
  10. # of the License, or (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program; if not, write to the Free Software
  19. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. #
  21. # Architecture by Stewart Allen
  22. # Implementation by Kenneth H. Cox <kcox@senteinc.com>
  23.  
  24. #
  25. # Initializes this library
  26. #
  27. proc vTcl:widget:lib:lib_tix {args} {
  28.     global vTcl
  29.     #
  30.     # see if we're running tixWish. if not, return
  31.     #
  32.     if {[info command tixNoteBookFrame] == ""} {
  33.         return
  34.     }
  35.     # setup required variables
  36.     vTcl:lib_tix:setup
  37.     # add items to toolbar
  38.     foreach i {
  39.         tixNoteBook tixLabelFrame tixComboBox tixMeter
  40.         tixFileEntry tixLabelEntry tixScrolledHList
  41.         tixScrolledListBox
  42.         tixSelect
  43.         tixPanedWindow tixOptionMenu
  44.     } {
  45.         set img_file [file join $vTcl(VTCL_HOME) images icon_$i.gif]
  46.         if {![file exists $img_file]} {
  47.             set img_file [file join $vTcl(VTCL_HOME) images icon_tix_unknown.gif]
  48.         }
  49.         image create photo "ctl_$i" -file $img_file
  50.         vTcl:toolbar_add $i $i ctl_$i ""
  51.     }
  52.     # The Widget Browser needs images for all tix classes.
  53.     # The images need to be called, e.g. ctl_tixNoteBookFrame.
  54.     # Don't put these in the toolbar, because they are not commands,
  55.     # only classes.
  56.     foreach i {
  57.         tixNoteBookFrame
  58.     } {
  59.         image create photo "ctl_$i" \
  60.             -file [file join $vTcl(VTCL_HOME) images icon_tix_unknown.gif]
  61.     }
  62.     vTcl:lib_tix:unscrew_option_db
  63. }
  64.  
  65. # Tix has screwed with the option database; reset it back to Tk's
  66. # defaults.  Otherwise, all widgets will be saved with color/font
  67. # (-foreground, -background, etc.) options specified.  Then we won't be
  68. # able to globally override them in the generated app!
  69. #
  70. # A different approach to this problem would be:
  71. #     1. add "don't save colors" and "don't save fonts" preferences
  72. #     2. modify vTcl:dump_widget_opt so that it pays attention to them
  73. #
  74. # Took some of this code from tk's palette.tcl.
  75. proc vTcl:lib_tix:unscrew_option_db {args} {
  76.     checkbutton .c14732
  77.     entry .e14732
  78.     scrollbar .s14732
  79.     text .t14732
  80.     # this is order dependent (e.g. font should come before Text.font
  81.     # and Entry.font) so use a list, not an array
  82.     set l ""
  83.     lappend l [list activeBackground \
  84.             [lindex [.c14732 configure -activebackground] 3]]
  85.     lappend l [list activeForeground \
  86.             [lindex [.c14732 configure -activeforeground] 3]]
  87.     lappend l [list background \
  88.             [lindex [.c14732 configure -background] 3]]
  89.     lappend l [list disabledForeground \
  90.             [lindex [.c14732 configure -disabledforeground] 3]]
  91.     lappend l [list font \
  92.             [lindex [.c14732 configure -font] 3]]
  93.     lappend l Entry.[list font \
  94.             [lindex [.e14732 configure -font] 3]]
  95.     lappend l Text.[list font \
  96.             [lindex [.t14732 configure -font] 3]]
  97.     lappend l [list foreground \
  98.             [lindex [.c14732 configure -foreground] 3]]
  99.     lappend l [list highlightBackground \
  100.             [lindex [.c14732 configure -highlightbackground] 3]]
  101.     lappend l [list highlightColor \
  102.             [lindex [.c14732 configure -highlightcolor] 3]]
  103.     lappend l [list insertBackground \
  104.             [lindex [.e14732 configure -insertbackground] 3]]
  105.     lappend l [list selectColor \
  106.             [lindex [.c14732 configure -selectcolor] 3]]
  107.     lappend l [list selectBackground \
  108.             [lindex [.e14732 configure -selectbackground] 3]]
  109.     lappend l [list selectForeground \
  110.             [lindex [.e14732 configure -selectforeground] 3]]
  111.     lappend l [list troughColor \
  112.             [lindex [.s14732 configure -troughcolor] 3]]
  113.     destroy .c14732 .e14732 .s14732 .t14732
  114.     # this causes tix to reset its internal notion of the defaults
  115.     tix resetoptions TK TK
  116.     # this reinits the options database back to the defaults we just
  117.     # queried, using the same priority level as tix used to screw us in
  118.     # the first place.
  119.     global tixOption
  120.     foreach e $l {
  121.         set option [lindex $e 0]
  122.         set value  [lindex $e 1]
  123.         #puts "option add *$option $value $tixOption(prioLevel)"
  124.         option add *$option $value $tixOption(prioLevel)
  125.     }
  126.  
  127.     # Prevent Tix from screwing us again (Tix calls "option add" when
  128.     # creating new classes).
  129.     if {[info procs vTcl:lib_tix:old_option] == ""} {
  130.         #puts "ABOUT TO RENAME COMMANDS"
  131.         rename option vTcl:lib_tix:old_option
  132.         rename vTcl:lib_tix:new_option option
  133.     }
  134. }
  135.  
  136. # Now I'm _really_ going out of my way to undo the screwing up of the
  137. # option DB that Tix does.  I rename the "option" command, and interpose
  138. # my own vTcl:lib_tix:new_option which tones down the damage that Tix
  139. # does by turning '*TixLabelFrame*Label.font' into
  140. # '*TixLabelFrame.Label.font'
  141. #
  142. proc vTcl:lib_tix:new_option {cmd args} {
  143.     #puts "lib_tix:new_option:$cmd $args:"
  144.     if {"$cmd" != "add"} {
  145.         return [eval vTcl:lib_tix:old_option $cmd $args]
  146.     }
  147.     #puts "\tit's an add"
  148.     set pattern  [lindex $args 0]
  149.     set value    [lindex $args 1]
  150.     set priority [lindex $args 2]
  151.     # if this is a Tix option, change all '*'s (except the first) with
  152.     # '.'s otherwise they screw up everything!
  153.     #puts "pattern:$pattern:"
  154.     if {[string match {\*Tix*} $pattern]} {
  155.         #puts "\twas: $pattern"
  156.         regsub {(.)\*} $pattern {\1.} pattern
  157.         #puts "\tis:  $pattern"
  158.     }
  159.     if {"$priority" == ""} {
  160.         vTcl:lib_tix:old_option add $pattern $value
  161.     } else {
  162.         vTcl:lib_tix:old_option add $pattern $value $priority
  163.     }
  164. }
  165.  
  166. #
  167. # move variable setup into proc so "sourcing" doesn't
  168. # install them.
  169. #
  170. proc vTcl:lib_tix:setup {} {
  171.     global vTcl
  172.  
  173.     #
  174.     # Preferences
  175.     set vTcl(tixPref,dump_colors) 0 ;# if 0, don't save -background, etc.
  176.  
  177.     #
  178.     # additional attributes to set on insert
  179.     #
  180.     set vTcl(tixComboBox,insert)       ""
  181.     set vTcl(tixFileEntry,insert)      "-label {FileEntry:} -options {label.anchor e}"
  182.     set vTcl(tixLabelEntry,insert)     "-label {LabelEntry:} -options {label.anchor e}"
  183.     set vTcl(tixLabelFrame,insert)     "-label label-me"
  184.     set vTcl(tixMeter,insert)          ""
  185.     set vTcl(tixNoteBook,insert)       ""
  186.     set vTcl(tixOptionMenu,insert)     "-label {OptionMenu: } -options {label.anchor e}"
  187.     set vTcl(tixPanedWindow,insert)    "-orient vertical"
  188.     set vTcl(tixPopupMenu,insert)      "-title PopupMenu"
  189.     set vTcl(tixScrolledHList,insert)  ""
  190.     set vTcl(tixScrolledListBox,insert) ""
  191.     set vTcl(tixSelect,insert)         "-radio 1"
  192.  
  193.     #
  194.     # add to procedure, var, bind regular expressions
  195.     #
  196.     if {"$vTcl(bind,ignore)" != ""} {
  197.         append vTcl(bind,ignore) "|tix"
  198.     } else {
  199.         append vTcl(bind,ignore) "tix"
  200.     }
  201.     append vTcl(proc,ignore) "|tix"
  202.     append vTcl(var,ignore)  "|tix"
  203.  
  204.     #
  205.     # add to valid class list
  206.     #
  207.     lappend vTcl(classes) \
  208.         TixAppContext \
  209.         TixBalloon \
  210.         TixButtonBox \
  211.         TixCObjView \
  212.         TixCheckList \
  213.         TixComboBox \
  214.         TixControl \
  215.         TixControl \
  216.         TixDetailList \
  217.         TixDialogShell \
  218.         TixDirList \
  219.         TixDirSelectBox \
  220.         TixDirSelectDialog \
  221.         TixDirTree \
  222.         TixDragDropContext \
  223.         TixExFileSelectBox \
  224.         TixExFileSelectDialog \
  225.         TixFileComboBox \
  226.         TixFileEntry \
  227.         TixFileSelectBox \
  228.         TixFileSelectDialog \
  229.         TixFloatEntry \
  230.         TixHList \
  231.         TixHListHeader \
  232.         TixIconView \
  233.         TixLabelEntry \
  234.         TixLabelFrame \
  235.         TixLabelWidget \
  236.         TixListNoteBook \
  237.         TixMeter \
  238.         TixMultiView \
  239.         TixNoteBook \
  240.         TixNoteBookFrame \
  241.         TixOptionMenu \
  242.         TixPanedWindow \
  243.         TixPopupMenu \
  244.         TixPrimitive \
  245.         TixResizeHandle \
  246.         TixScrolledGrid \
  247.         TixScrolledHList \
  248.         TixScrolledListBox \
  249.         TixScrolledTList \
  250.         TixScrolledText \
  251.         TixScrolledWidget \
  252.         TixScrolledWindow \
  253.         TixSelect \
  254.         TixShell \
  255.         TixSimpleDialog \
  256.         TixStackWindow \
  257.         TixStatusBar \
  258.         TixStdButtonBox \
  259.         TixStdDialogShell \
  260.         TixTree \
  261.         TixVResize \
  262.         TixVStack \
  263.         TixVTree
  264.  
  265.     #
  266.     # register additional options that might be on Tix widgets,
  267.     # and the option information that the Attribute Editor needs.
  268.     #
  269.     lappend vTcl(opt,list) \
  270.             -activatecmd \
  271.             -after \
  272.             -before \
  273.             -browsecmd \
  274.             -buttons \
  275.             -createcmd \
  276.             -dynamicgeometry \
  277.             -editable \
  278.             -expand \
  279.             -handleactivebg \
  280.             -handlebg \
  281.             -label \
  282.             -listcmd \
  283.             -listwidth \
  284.             -max \
  285.             -min \
  286.             -options \
  287.             -panebd \
  288.             -panerelief \
  289.             -postcmd \
  290.             -raisecmd \
  291.             -scrollbar \
  292.             -separatoractivebg \
  293.             -separatorbg \
  294.             -size \
  295.             -spring \
  296.             -validatecmd
  297.     # make sure the options appear sorted in the attribute editor
  298.     #set vTcl(opt,list) [lsort $vTcl(opt,list)]
  299.     set vTcl(opt,-activatecmd)     { {Activate Cmd}      longname command {} }
  300.     set vTcl(opt,-after)           { {After}             longname type {} }
  301.     set vTcl(opt,-allowzero)       { {Allow Zero}        longname choice  {1 0} }
  302.     set vTcl(opt,-before)          { {Before}            longname type {} }
  303.     set vTcl(opt,-browsecmd)       { {Browse Cmd}        longname command {} }
  304.     set vTcl(opt,-buttons)         { {Buttons}           longname type    {} }
  305.     set vTcl(opt,-createcmd)       { {Create Cmd}        longname command {} }
  306.     set vTcl(opt,-dynamicgeometry) { {Dynamic Geometry}  longname choice  {1 0} }
  307.     set vTcl(opt,-editable)        { Editable            longname choice  {0 1} }
  308.     set vTcl(opt,-expand)          { {Expand}            longname type    {} }
  309.     set vTcl(opt,-fancy)           { Fancy               longname choice  {0 1} }
  310.     set vTcl(opt,-handleactivebg)  { {Handle ActiveBg}   longname type    {} }
  311.     set vTcl(opt,-handlebg)        { {Handle BgColor}    longname type    {} }
  312.     set vTcl(opt,-history)         { History             longname choice  {false true} }
  313.     set vTcl(opt,-label)           { Label               longname type    {} }
  314.     set vTcl(opt,-listcmd)         { {List Cmd}          longname command {} }
  315.     set vTcl(opt,-listwidth)       { {List Width}        longname type    {} }
  316.     set vTcl(opt,-max)             { {Maxsize}           longname type    {} }
  317.     set vTcl(opt,-min)             { {Minsize}           longname type    {} }
  318.     set vTcl(opt,-options)         { {Options}           longname type    {} }
  319.     set vTcl(opt,-panebd)          { {Paneborder Width}  longname type    {} }
  320.     set vTcl(opt,-panerelief)      { {Paneborder Relief} longname choice
  321.         {sunken raised groove ridge flat} }
  322.     set vTcl(opt,-postcmd)         { {Post Cmd}          longname command {} }
  323.     set vTcl(opt,-prunehistory)    { {Prune History}     longname choice  {false true} }
  324.     set vTcl(opt,-radio)           { Radio               longname choice  {0 1} }
  325.     set vTcl(opt,-raisecmd)        { {Raise Cmd}         longname command {} }
  326.     set vTcl(opt,-scrollbar)       { Scrollbar           longname choice  
  327.         {auto both none x y} }
  328.     set vTcl(opt,-separatoractivebg) { {Separator ActiveBg} longname type {} }
  329.     set vTcl(opt,-separatorbg)     { {Separator BgColor} longname type    {} }
  330.     set vTcl(opt,-size)            { {Size}              longname type    {} }
  331.     set vTcl(opt,-spring)          { {Spring}            longname choice  {1 0} }
  332.     set vTcl(opt,-validatecmd)     { {Validate Cmd}      longname command {} }
  333.  
  334.     #
  335.     # define dump procedures for widget types
  336.     #
  337.     set vTcl(TixComboBox,dump_opt)         vTcl:lib_tix:dump_widget_opt
  338.     set vTcl(TixFileEntry,dump_opt)        vTcl:dump:TixFileEntry
  339.     set vTcl(TixLabelEntry,dump_opt)       vTcl:dump:TixLabelEntry
  340.     set vTcl(TixLabelFrame,dump_opt)       vTcl:dump:TixLabelFrame
  341.     set vTcl(TixMeter,dump_opt)            vTcl:lib_tix:dump_widget_opt
  342.     set vTcl(TixNoteBook,dump_opt)         vTcl:dump:TixNoteBook
  343.     set vTcl(TixOptionMenu,dump_opt)       vTcl:dump:TixOptionMenu
  344.     set vTcl(TixPanedWindow,dump_opt)      vTcl:dump:TixPanedWindow
  345.     set vTcl(TixPopupMenu,dump_opt)        vTcl:lib_tix:dump_widget_opt
  346.     set vTcl(TixScrolledHList,dump_opt)    vTcl:lib_tix:dump_widget_opt
  347.     set vTcl(TixScrolledListBox,dump_opt)  vTcl:lib_tix:dump_widget_opt
  348.     set vTcl(TixSelect,dump_opt)           vTcl:dump:TixSelect
  349.  
  350.     #
  351.     # define whether or not do dump children of a class
  352.     #
  353.     set vTcl(TixComboBox,dump_children)         0
  354.     set vTcl(TixFileEntry,dump_children)        0
  355.     set vTcl(TixLabelEntry,dump_children)       0
  356.     set vTcl(TixLabelFrame,dump_children)       0
  357.     set vTcl(TixMeter,dump_children)            0
  358.     set vTcl(TixNoteBook,dump_children)         0
  359.     set vTcl(TixOptionMenu,dump_children)       0
  360.     set vTcl(TixPanedWindow,dump_children)      0
  361.     set vTcl(TixPopupMenu,dump_children)        0
  362.     set vTcl(TixScrolledHList,dump_children)    0
  363.     set vTcl(TixScrolledListBox,dump_children)  0
  364.     set vTcl(TixSelect,dump_children)           0
  365. }
  366.  
  367. #
  368. # individual widget commands executed after insert
  369. #
  370. proc vTcl:widget:tixNoteBook:inscmd {target} {
  371.     # Add two pages to start with.  Unfortunately, additional pages have
  372.     # to be added manually by the user, and the project re-read into vtcl.
  373.     return "
  374.         $target add page1 -label {Page 1};
  375.         $target add page2 -label {Page 2};
  376.         $target subwidget page1 configure -width 30 -height 30;
  377.         $target subwidget page2 configure -width 30 -height 30;
  378.     "
  379. }
  380.  
  381. proc vTcl:widget:tixPanedWindow:inscmd {target} {
  382.     # Add two pages to start with.  Unfortunately, additional pages have
  383.     # to be added manually by the user, and the project re-read into vtcl.
  384.     return "
  385.         $target add page1
  386.         $target add page2
  387.         $target subwidget page1 configure -width 30 -height 30;
  388.         $target subwidget page2 configure -width 30 -height 30;
  389.     "
  390. }
  391.  
  392. proc vTcl:widget:tixPopupMenu:inscmd {target} {
  393.     return "
  394.         $target bind \[winfo toplevel $target\]
  395.         set menu \[$target subwidget menu\]
  396.         \$menu add command -label Entry1
  397.         \$menu add command -label Entry2
  398.         \$menu add separator
  399.         \$menu add command -label Entry2
  400.     "
  401. }
  402.  
  403. proc vTcl:widget:tixLabelFrame:inscmd {target} {
  404.     return "
  405.         $target subwidget frame configure -width 30 -height 30;
  406.     "
  407. }
  408.  
  409. proc vTcl:widget:tixMeter:inscmd {target} {
  410.     return "$target configure -value .3"
  411. }
  412.  
  413. proc vTcl:widget:tixFileEntry:inscmd {target} {
  414.     return "
  415.         $target subwidget frame configure -highlightthickness 2
  416.     "
  417. }
  418.  
  419. proc vTcl:widget:tixOptionMenu:inscmd {target} {
  420.     # Add two options to start with.  Unfortunately, additional options have
  421.     # to be added manually by the user, and the project re-read into vtcl.
  422.     return "
  423.         $target add command opt1 -label {Option 1}
  424.         $target add separator sep
  425.         $target add command opt2 -label {Option 2}
  426.     "
  427. }
  428.  
  429. proc vTcl:widget:tixSelect:inscmd {target} {
  430.     # Add two buttons to start with.  Unfortunately, additional options have
  431.     # to be added manually by the user, and the project re-read into vtcl.
  432.     return "
  433.         $target add but1 -bitmap warning
  434.         $target add but2 -bitmap error
  435.         $target add but3 -bitmap info
  436.     "
  437. }
  438.  
  439. #
  440. # per-widget action to take upon edit-mode double-click
  441. #
  442. proc vTcl:widget:tixNoteBook:dblclick {target} {
  443.     #puts "called edit-mode double-click on $target"
  444. }
  445.  
  446. proc vTcl:widget:tixLabelFrame:dblclick {target} {
  447.     #puts "called edit-mode double-click on $target"
  448. }
  449.  
  450. proc vTcl:widget:tixComboBox:dblclick {target} {
  451.     #puts "called edit-mode double-click on $target"
  452. }
  453.  
  454. #
  455. # per-widget-class dump procedures
  456. #
  457. proc vTcl:dump:TixNoteBook {target basename} {
  458.     global vTcl
  459.     set result [vTcl:lib_tix:dump_widget_opt $target $basename]
  460.     set entries [$target pages]
  461.     foreach page $entries {
  462.         set conf [$target pageconfigure $page]
  463.         set pairs [vTcl:conf_to_pairs $conf ""]
  464.         append result "$vTcl(tab)$basename add $page \\\n"
  465.         append result "[vTcl:clean_pairs $pairs]\n"
  466.     }
  467.     foreach page $entries {
  468.         set subwidget [$target subwidget $page]
  469.         append result [vTcl:lib_tix:dump_subwidgets $subwidget]
  470.     }
  471.     return $result
  472. }
  473.  
  474. proc vTcl:dump:TixPanedWindow {target basename} {
  475.     global vTcl
  476.     set result [vTcl:lib_tix:dump_widget_opt $target $basename]
  477.     set entries [$target panes]
  478.     foreach page $entries {
  479.         set conf [$target paneconfigure $page]
  480.         foreach c $conf { # Filter the valid options out
  481.             if [regexp -- {^-(after|allow|at|before|expand|max|min|size)} $c] {
  482.                 lappend validcfg $c
  483.             }
  484.         }
  485.         set pairs [vTcl:conf_to_pairs $validcfg ""]
  486.         append result "$vTcl(tab)$basename add $page \\\n"
  487.         append result "[vTcl:clean_pairs $pairs]\n"
  488.     }
  489.     foreach page $entries {
  490.         set subwidget [$target subwidget $page]
  491.         append result [vTcl:lib_tix:dump_subwidgets $subwidget]
  492.     }
  493.     return $result
  494. }
  495.  
  496. proc vTcl:dump:TixOptionMenu {target basename} {
  497.     global vTcl
  498.     set result [vTcl:lib_tix:dump_widget_opt $target $basename]
  499.     set entries [$target entries]
  500.     foreach entry $entries {
  501.         set conf [$target entryconfigure $entry]
  502.         set pairs [vTcl:conf_to_pairs $conf ""]
  503.         append result "$vTcl(tab)$basename add "
  504.         if {[llength $pairs] == 0} {
  505.             append result "separator $entry\n"
  506.         } else {
  507.             set index [lsearch -glob $pairs -command*]
  508.             if {$index > -1} {
  509.                 set pairs [lreplace $pairs $index [expr $index+1]]
  510.             }
  511.             append result "command $entry \\\n"
  512.             append result "[vTcl:clean_pairs $pairs]\n"
  513.         }
  514.     }
  515.     return $result
  516. }
  517.  
  518. proc vTcl:dump:TixLabelFrame {target basename} {
  519.     set output [vTcl:lib_tix:dump_widget_opt $target $basename]
  520.     append output [vTcl:lib_tix:dump_subwidgets [$target subwidget frame]]
  521.     return $output
  522. }
  523.  
  524. proc vTcl:dump:TixLabelEntry {target basename} {
  525.     global vTcl
  526.     set output [vTcl:lib_tix:dump_widget_opt $target $basename]
  527.     return $output
  528. }
  529.  
  530. proc vTcl:dump:TixFileEntry {target basename} {
  531.     global vTcl
  532.     set output [vTcl:lib_tix:dump_widget_opt $target $basename]
  533.     append output "$target subwidget frame configure -highlightthickness 2\n"
  534.     return $output
  535. }
  536.  
  537. proc vTcl:dump:TixSelect {target basename} {
  538.     global vTcl
  539.     set result [vTcl:lib_tix:dump_widget_opt $target $basename]
  540.     foreach button [$target subwidgets -class Button] {
  541.         set conf [list \
  542.                 [$button configure -bitmap] \
  543.                 [$button configure -image]]
  544.         set pairs [vTcl:conf_to_pairs $conf ""]
  545.         set button_name [string range $button \
  546.                 [expr 1 + [string last . $button]] end]
  547.         append result "$vTcl(tab)$basename add $button_name \\\n"
  548.         append result "[vTcl:clean_pairs $pairs]\n"
  549.     }
  550.     # Destroy unused label subwidget, but not while running in vTcl.
  551.     if {"[$target cget -label]" == ""} {
  552.         append result "$vTcl(tab)# destroy unused label subwidget\n"
  553.         append result "$vTcl(tab)global vTcl\n"
  554.         append result "$vTcl(tab)if \{!\[info exists vTcl\]\} \{destroy \[$basename subwidget label\]\}\n"
  555.     }
  556.     return $result
  557. }
  558.  
  559. # Utility proc.  Dump a megawidget's children, but not those that are
  560. # part of the megawidget itself.  Differs from vTcl:dump:widgets in that
  561. # it dumps the geometry of $subwidget, but it doesn't dump $subwidget
  562. # itself (`vTcl:dump:widgets $subwidget' doesn't do the right thing if
  563. # the grid geometry manager is used to manage children of $subwidget.
  564. proc vTcl:lib_tix:dump_subwidgets {subwidget} {
  565.     global vTcl
  566.     set output ""
  567.     set widget_tree [vTcl:widget_tree $subwidget]
  568.     foreach i $widget_tree {
  569.         set basename [vTcl:base_name $i]
  570.         # don't try to dump subwidget itself
  571.         if {"$i" != "$subwidget"} {
  572.             set class [vTcl:get_class $i]
  573.             #puts "kc:dump_subwidgets1:[$vTcl($class,dump_opt) $i $basename]:"
  574.             append output [$vTcl($class,dump_opt) $i $basename]
  575.         }
  576.         #puts "kc:dump_subwidgets2:[vTcl:dump_widget_geom $i $basename]:"
  577.         append output [vTcl:dump_widget_geom $i $basename]
  578.     }
  579.     return $output
  580. }
  581.  
  582. # Utility proc.  Ignore color options (-background, etc.) based on
  583. # preference.
  584. #
  585. # returns:
  586. #   1 means save the option
  587. #   0 means don't save it
  588. proc vTcl:lib_tix:save_option {opt} {
  589.     global vTcl tix_library
  590.     # never save -bitmap options on tix widgets; they are always
  591.     # hard-coded to the tix library directory
  592.     if [string match *${tix_library}* $opt] {
  593.         #puts "kc:save_option:ignoring $opt"
  594.         return 0
  595.     } elseif {$vTcl(tixPref,dump_colors) == 0 \
  596.             && [regexp -- {^-(.*background|.*foreground|.*color|font) } $opt]} {
  597.         #puts "kc:save_option:ignoring $opt"
  598.         return 0
  599.     } else {
  600.         return 1
  601.     }
  602. }
  603.  
  604. # Utility proc.  Dump a tix widget.
  605. # Differs from vTcl:dump_widget_opt in that it tries harder to avoid
  606. # dumping options that shouldn't really be dumped, e.g. -fg,-bg,-font.
  607. proc vTcl:lib_tix:dump_widget_opt {target basename} {
  608.     global vTcl
  609.     set result ""
  610.     set class [vTcl:get_class $target]
  611.     set result "$vTcl(tab)[vTcl:lower_first $class] $basename"
  612.     set opt [$target conf]
  613.     set keep_opt ""
  614.     foreach e $opt {
  615.         if [vTcl:lib_tix:save_option $e] {
  616.             lappend keep_opt $e
  617.         }
  618.     }
  619.     set p [vTcl:get_opts $keep_opt]
  620.     if {$p != ""} {
  621.         append result " \\\n[vTcl:clean_pairs $p]\n"
  622.     } else {
  623.         append result "\n"
  624.     }
  625.     append result [vTcl:dump_widget_bind $target $basename]
  626.     return $result
  627. }
  628.